00100	C***** BEAMS,  XNOTE, BAUTO, UPDATE, SLEND, POSIT *******
00200		SUBROUTINE BEAMS
00250		INTEGER UPDN
00300		COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,DMAX,
00400		1 UMAX,AA,JMAX,X,Y,BB,RNX(1982)
00500		1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72),ML
00600		1 /PTR/PWDS(250),ITEM,LL,IS,IX
00700		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00800		COMMON R2,JAZ,CENTR,JBZ,RJQ(20),JQ(20) /STF/RSTFAC(8),RSTJ2
00900		COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
01000		1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
01100		1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
01300		DIMENSION R(10,80),POSNT(0/82)
01350		EQUIVALENCE (NTC,RN(3883)),(POSNT,RN(3801)),(R,RN(3001))
01450		1,(STEM,RN(2999)),(RMODE,RN(3918)),(VX2,VX(2))
01500		DATA BX/25./,BY/.5/,DFAC/6./,CURV/0.9/
01600	C  THESE ARE USED TO DETERMINE CURVE OF SLURS AT 63 (21700)
01700	
01710		IF(RMODE.LT.500)GO TO 251
01720		IF(MODE.EQ.4)RETURN
01730	C  PICKS UP SLURS ONLY WHEN USING SUBR. 'EXTRA' *********
01800	251	INVT=-1
01900		IF(MODE.EQ.3)GO TO 25
02000		IF(REND.NE.0)GO TO 25
02100		REND=3
02200	25	DO 1500 K=1,72
02300		IF(INP(K).EQ.'B')GO TO 22
02400	C  B=AUTOMATIC BEAMS.
02500		IF(INP(K).NE.'*')GO TO 1500
02600	15	INP(72)='*'
02700		GO TO 500
02800	1500	IF(INP(K).EQ.ISEMI)GO TO 500
02900		GO TO 15
03000	C ABOVE FOR 2ND LNE OF INPUT. IF LNS ENDS WITHOUT * OR ;, IT PUTS IN *
03100	22	REREAD F78F,A,B,C
03200	C  TYPE '2B' OR '3B' ETC. FOR AUTOMATIC BEAMS. (2=DUPLE  3=TRIPLE)
03300		IF(IREAD.NE.-1)GO TO 1122
03325		A=B
03337		B=C
03350	C  IREAD=-1 WHEN READING SOS FILES. (=-2 WITH ET FILES.)
03400	1122	A=A/2.
03500	C  '2'=1  '3'=1.5   '2B 3;'  MEANS THERE'S A 3 NOTE PICK-UP.
03600		IF(STEM)STEM=0
03700	C STEM=10 OR 20 IF ALREADY SETUP IN NOTES
03800		K=0
03900		N=0
04000		J=0
04100		INP(72)='*'
04110	C  PICKS UP RHYTHM FROM TIME WHEN MODE=2 (NOW IT =4)
04120		IF(B.EQ.0)GO TO 122
04130		K=B
04140		B=0
04150		C=0
04160		DO 2122 NN=1,K
04170		IF(V(NN))GO TO 3122
04180		B=B+1
04190	C  UPDATE COUNTER
04200		GO TO 2122
04210	3122	N=N+1
04220	C TO SKIP OVER RESTS
04230	2122	C=C+ABS(V(NN))
04240		IF(B.LE.1)GO TO 122
04250		IF(C.GT.A)GO TO 122
04260	C SKIPS IF PICK-UP HAS LONGER TOTAL THAN BEAM RANGE (A)
04270		J=2
04280		VX(1)=1
04290		VX2=B
04295	C  PUTS BEAM ON PICK-UP IF MORE THAN ONE NOTE.
04300	122	K=K+1
04400		L=K
04500	222	C=ABS(V(K))
04600		IF(C.EQ.4./88.)GO TO 522 
04610	C  CATCHES 88TH NOTES (GRACE NOTES)???
04800		IF(V(K).GT.0)GO TO 922
04900	1022	N=N+1
05000	C  SUBTRACTS NUMB. FOR REST.
05100		IF(C.GE.A)GO TO 1222
05200	1322	L=L+1
05300		GO TO 422
05400	1222	IF(AMOD(C,A).NE.0)GO TO 622
05500		IF(K-L.LE.1)GO TO 522
05600		L=L+1
05700		GO TO 722
05800	922	IF(C.EQ.A)GO TO 522
05850		IF(C.GE.1)L=L+1
05900	422	IF(K.EQ.IRHY)GO TO 322
06000		K=K+1
06100	5022	B=V(K)
06200		IF(B.NE.4./88.)GO TO 2022
06205		JMP=K
06210	3022	IF(V(K+1).NE.4./88.)GO TO 4022
06220	C  TO BEAM GRACE NOTES WHEN IN AUTOMATIC MODE.
06230		K=K+1
06240		GO TO 3022
06250	C  GO BACK FOR MORE
06260	4022	IF(K.EQ.JMP)GO TO 422
06270	C  GO AWAY IF THERE IS ONLY ONE GRACE NOTE.
06280		CALL BAUTO(J,JMP,K,N)
06290	C  I HOPE THE ARGS. ARE OK!
06340		IF(JMP.EQ.L)L=K
06365	C DOES GRACE NOTE BEAM COME UNDER BIG BEAM(JMP≠L) OR NOT(JMP=L).?
06390		GO TO 422
06410	2022	C=C+ABS(B)
06420		IF(B.GT.0)GO TO 1922
06425		IF(-B.LT.A)GO TO 1022
06427	C GO BACK TO PUT A REST UNDER A BEAM.
06428		N=N+1
06429	C  UPDATE REST COUNTER IF IT GETS TO HERE.
06430	1922	IF(C.LT.A-.0001)GO TO 422
06500		IF(C.LT.A+.0001)GO TO 722
06600	C  .0001 FOR ROUNDOFF PROBLEMS
06700		C=AMOD(C,A)
06800		IF(K-L.LE.1)GO TO 622
06900		CALL BAUTO(J,L,K-1,N)
07000	622	L=K
07100		IF(ABS(V(K)).GE.A)GO TO 77
07125		IF(C.NE.0)GO TO 422
07150	77	L=L+1
07200		GO TO 422
07300	722	IF(K.EQ.L)GO TO 522
07400	1722	DO 1422 IT=L,K
07500		B=V(IT)
07510		IF(B.EQ.4./6.)GO TO 1522
07555		IF(B.EQ..875)GO TO 1422
07577	C .875=(8..)
07600		IF(B.GT..75)GO TO 1522
07650	1422	CONTINUE
07700	C WON'T PUT BEAMS WHERE NOT LOGICAL. CATCHES QUINTS AND SEXT'S.
07800		IF(V(L)+V(K).LT.A+.0001)CALL BAUTO(J,L,K,N)
07900	C  DOES ONLY DUPLES AT THIS POINT.
08000	522	IF(K.LT.IRHY)GO TO 122
08100	
08200	322	IF(J.EQ.0)RETURN
08300	C  NO BEAMS - SO GO BACK.
08400		DO 822 K=J+1,50
08500	C  USES ONLY 68 SLOTS IN 'V'
08600	822	VX(K)=0
08700		J=0
08800		GO TO 511
08900	1522	IF(IT-1.GT.L)GO TO 1622
09000	1822	L=IT+1
09100		IF(L.LT.K)GO TO 1722
09200		GO TO 522
09300	1622	CALL BAUTO(J,L,IT-1,N)
09400		GO TO 1822
09500	C  ALL THIS ↑↑ FOR QUARTERS IN TRIPLE TIME UNITS!
09600	CC27	DO 26 L=1,50
09700	CC26	VX(L)=V(L)
09800	C  BECAUSE MODE 3 IS NOW ACCENTS, ETC.
09900	CC	GO TO 511
10000	
10100	500	REREAD F78F,VX
10110		IF(MODE.EQ.5)NTC=NTC-1
10120	C  NTC=NUM OF NTS NOW
10200		J=0
10300		IF(IREAD.EQ.-1)J=1
10310	C  SKIPS LINE #S IN SOS FILES. (=-2 IS FOR ET FILES.)
10400	511	J=J+1
10500		N=VX(J)
10700		JMP=1
10800	505	L=0
10900		K=0
11000		POS=-10.
11100		IF(MODE.EQ.3)GO TO 5032
11200	C  MODE 3 IS FOR ACCENTS ETC.
11400		RN(8+IS)=0
11500		RN(9+IS)=0
11600		IT=0
11605		UPDN=0
11610		IF(MODE.EQ.5)GO TO 104
11612		IF(STEM.EQ.0)GO TO 503
11630	C  UPDN=2=STEMS DOWN, (SLUR DIP UP)  =1, OPPOSITE.
11635	104	JA=J+1
11640		B=VX(JA)
11650	C THE 2ND NOTE (-=DIP DOWN ALWAYS; +100=UP ALWAYS, ORD.=AUTOMATIC)
11660		IF(B.LT.100)GO TO 512
11670		UPDN=2
11680		B=B-100
11682		IF(B.GT.100)B=100-B
11688	C  TYPE -NUM OR 200+NUM FOR DIP DOWN.
11690	512	IF(B)UPDN=1
11692		VX(JA)=B
11694		IF(MODE.EQ.4)GO TO 503
11700		BRK=AMOD(VX(J),1.)*10.
11800		IF(BRK.EQ.0)GO TO 503
11900	C NEXT FOR TRIPL. BRACKET, ETC.  ADD DESIRED .NUM TO 1ST NUM.
12100		RN(9+IS)=BRK+.0001
12300		GO TO 5030
12400	503	IF(N.GT.0)GO TO 5031
12500		IT=-1
12600	C6/75	POS=-1.3
12650		CALL SLEND
12700	C  -1= SLUR INTO 1ST NOTE.
12800	C  SETS POS OF LFT SIDE (-10+9, THEN +2)
12900		GO TO 5060
13000	5031	IF(N.LE.NTC)GO TO 5030
13050	C  NTC=NUM OF NTS
13100	C6/75	POS=202
13150		CALL SLEND
13175	C  SLEND CHECKS ON END POINTS OF THIS STAFF
13200		GO TO 504
13300	C  -1=1ST SLUR FROM NO NOTE; 99= LAST, TO NO NOTE
13310	5032	IF(N.GT.IRHY)N=IRHY
13320	C TRAPS ERROR OF TRYING TO PUT MARK ON NON-EXISTENT NOTE.
13400	5030	L=L+1
13500	502	K=K+1
13600		IF(R(1,K).NE.1.)GO TO 502
13700	C  IS IT A NOTE?
13800		P=R(3,K)
13900		IF(P.EQ.POS)GO TO 502
14000	C  SKIPS DBLSTPS
14100		POS=P
14200	506	IF(L.LT.N)GO TO 5030
14300	5060	IF(MODE.EQ.3)GO TO 30
14400	C  NOW SLUR STARTS
14500		IF(JMP)GO TO 504
14600	C  JMP=-1 MEANS END NOTE OF GROUP
14700		J=J+1
14830		NN=VX(J)
14870	C  IF 2ND NUM IS .LE. 1ST , THEN 2-NOTE SLUR. (-1 GOES TO 1)
14900		IF(NN.EQ.0)NN=N+1
14975		IF(NN.EQ.0)NN=1
14980		IF(NN)GO TO 777
14987		IF(NN.LE.N)NN=N+1
15000	C  FOR USE WITH AUTO-BEAMS OR DIP UP.  2-NOTE SLUR OR BEAM UP.
15200	CC777	IF(STEM)GO TO 5061
15225	777	IF(MODE.NE.4)GO TO 5061
15250	CC	IF(MODE.NE.4)GO TO 177
15275		IF(STEM.LE.0)GO TO 5061
15300	C  AUTOMATIC DIP DIRECTION FOR SLURS WITH AUTO. BEAMS.
15310	177	MK=K
15320	877	IF(R(1,MK).EQ.1)GO TO 477
15330		MK=MK+1
15340		GO TO 877
15350	C  FOR SLUR INTO FIRST NOTE WITH AUTO BEAMS.
15400	477	A=19.-R(5,MK)
15510		IF(NN.GE.0)GO TO 277
15520		IF(A.GT.0)GO TO 377
15530	277	IF(A.GE.0)GO TO 5061
15540		IF(NN.LE.0)GO TO 5061
15550	377	NN=-NN
15600	5061	MK=N
15700		N=NN
15800		IF(N)N=-N
15900		M=K
16000		JA=3
16100		JB=4
16200		KN=K
16300		RB=0
16400		IF(MODE.EQ.4)GO TO 550
16500		IBR=6
16600	C  6=SLUR, 7=BRACK. FOR TRIPLETS, ETC.
16700	CC*** NOT NEEDED NOW WITH UPDN FEATURE.	IF(STEM.GE.0)NN=-NN
16800		IF(IT)GO TO 550
16900	C  IT=-1=SLUR INTO 1ST NOTE.
17000		A=XNOTE(K)
17100	C XNOTE IS AMOD(R(4,K),100.)
17200	C  SAVES LEVEL OF 1ST NOTE.
17300	504	RB=2
17400		B=AMOD(R(6,K),1.0)
17500		IF(B.GE.0.5)RB=3.
17600		IF(B.EQ.0.4)RB=5.
17700	C   THESE ARE FOR >(.5) AND ∧(.4) ACCENTS
17800		IF(NN)RB=-RB
17900	C  DIP IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
18000	550	RN(JA+IS)=POS
18050		B=XNOTE(K)
18075		IF(MODE.EQ.4)B=R(4,K)
18087	C  TO MAKE MINI-BEAMS ON GRACE NOTES WHEN NEEDED.
18090		IF(MODE.NE.5)GO TO 513
18095		SLUR=0
18097	C A FLAG FOR LATER USE.
18100		MB=R(5,K)/10.
18105	CC	IF(JMP.GE.0.AND.UPDN.EQ.0)GO TO 515
18106		IF(UPDN.EQ.0)GO TO 515
18110		IF(MB.EQ.UPDN)GO TO 515
18112		X=6
18118		IF(RB)X=-X
18125		RB=RB+X
18130		JA=3
18132		IF(JMP)JA=6
18150		IF(RB)GO TO 204
18160		IF(UPDN.EQ.2)GO TO 516
18170	204	IF(UPDN.EQ.1)GO TO 516
18180	C  ABOVE FOR VARIOUS COMBINATIONS OF STEM DIRECTIONS
18500		RB=-RB
18503		NN=-NN
18506	516	IF(K.GT.1)GO TO 16
18509		IF(IT)GO TO 513
18512	16	IF(K.NE.NTC)GO TO 116
18515		IF(N.GT.NTC)GO TO 513
18518	C JUMP IF N=99, BY PASS IF K IS NOT LAST NOTE OF LINE.
18521	116	SLUR=1.
18524		IF(UPDN.EQ.1)SLUR=-SLUR
18527		SLUR=SLUR*RSTJ2
18530		RN(JA+IS)=RN(JA+IS)+SLUR
18533	C  THIS NOT DONE IF SLUR TO FIRST NOTE
18536		GO TO 513
18539	
18542	517	IF(MB.EQ.1)GO TO 513
18545		IF(RB)RB=-RB
18548		GO TO 518
18551	515	UPDN=MB
18554	C AUTO SLUR DIP DEPENDS ON STEM DIREC. OF 1ST NOTE. (WHOLE NTS??)
18557		IF(NN)GO TO 517
18560		IF(MB.NE.1)GO TO 513
18563		RB=-RB
18566	518	NN=-NN
18569	513	RN(JB+IS)=B+RB
18572		JA=6
18575		JB=5
18578	C  MK=# OF 1ST NOTE, N=END NOTE NOW
18581		JMP=-JMP
18600		IF(JMP.GT.0)GO TO 1503
18700	C  GO FIND RT. SIDE OF SLUR
18800		IF(N.LE.MK)N=MK+1
18900	C  PICKS UP TYPO ERRORS
19000		JK=0
19100		IF(R(7,K).GE.10)JK=-1
19200	C  CHECKS FOR DOT AFTER 1ST NOTE -- FOR TIES.
19300		GO TO 503
19400	
19500	1503	RN(2+IS)=STAFF
19600		IF(MODE.EQ.4)GO TO 35
19700		RN(8+IS)=-1
19800		RN(1+IS)=5
19900		IF(IT)RN(4+IS)=RN(5+IS)
20000		NN=-NN
20100	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
20200		IF(MK.EQ.IRHY)GO TO 61
20210		IF(N.EQ.1)GO TO 61
20300	CC	IF(((XNOTE(K).NE.A.OR.N-MK.GT.1).AND.IT.GE.0.
20400	CC	1 ).OR.IT)GO TO 60
20410		IF(IT)GO TO 60
20420		IF(XNOTE(K).NE.A)GO TO 60
20430		IF(N-MK.GT.1)GO TO 60
20530	CCC	IF(R(5,M).NE.R(5,K))GO TO 65
20565	CCC  FOR SLUR OVER CHROMATIC CHANGE ON SAME NOTE NAME.
20570	C  M=1ST NOTE OF SLUR, K=LAST
20575		IF(AMOD(R(5,K),10.0).GT.0)GO TO 65
20580	C  JUMP IF LAST NOTE AS ACCI.
20600	C  JUMP IF NOT ADJACENT NOTE AT SAME PITCH AND NOT 1ST OR LAST.
20700	61	C=9
20800		IF(JK)C=12
20900		IF(RN(6+IS)-RN(3+IS)-C*RSTJ2)GO TO 65
20905	C  JUMP IF SLUR IS VERY SHORT
21000		IF(IT)A=XNOTE(K)
21010	C  IT=-1=SLUR INTO 1ST NOTE.
21100		A=A+.7
21200		IF(NN.GT.0)A=A-1.4
21300	C  TO RAISE OR LOWER IT .5
21400		RN(4+IS)=A
21500		RN(5+IS)=A
21600		B=-2
21700		IF(JK)B=-3
21800	C  JK=-1 WHEN NOTE IS DOTTED.
21900	C THIS PUTS TIE BETWEEN (NOT ABOVE OR BELOW) NTS. NO STEM CHNG.
22000		RN(8+IS)=B
22010		IF(SLUR.EQ.0)GO TO 65
22020		RN(3+IS)=RN(3+IS)-SLUR
22030		RN(6+IS)=RN(6+IS)-SLUR
22040	C  PUSH SLUR BACK TO WHERE IT WAS
22100		GO TO 65
22800	
22900	C** 6/16/75 60	IF(STEM.GE.0)GO TO 508
22950	60	IF(STEM.GE.0)GO TO 200
22975		IF(MODE.EQ.5)GO TO 200
22987	C  JUMP IF SLURS**************
23000	C  NEXT IS STEM INVERTER.  SKIP IF AUTOMATIC BEAMS OR 'SU' 'SD' IN USE.
23100		JB=1
23200		RB=10.
23300		IF(NN)GO TO 509
23400	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
23500		RB=-RB
23600		JB=2
23700	509	DO 507 L=M,K
23800		IF(R(1,L).NE.1.)GO TO 507
23900		JA=R(5,L)/10.
24000		IF(JA.NE.JB)GO TO 507
24100		R(5,L)=R(5,L)+RB
24200		INVT=0
24300	C**********************************************
24400	507	CONTINUE
24500	CC508	IF(N.GT.100)GO TO 514
24600	C**** NO LONGER USED.  USE 'SD' 'SU' **  JUMP IF ONLY REVERSING STEMS.
24700		GO TO 200
24800	62	IF(NN)GO TO 64
24900		IF(A.EQ.DMAX)GO TO 65
25000		AA=B-DMAX
25100		GO TO 63
25200	65	AA=0
25300		GO TO 63
25400	64	IF(A.EQ.UMAX)GO TO 65
25500		AA=UMAX-B
25600	63	RA=RN(6+IS)
25700		RB=RN(3+IS)
25800		X=CURV+(RA-RB)/BX+ABS(RN(4+IS)-RN(5+IS))/10.
25850	C  CURVE DEPENDS ON LENGTH, TILT AND NOTES BETWEEN.
25900		IF(AA.GT.0)X=X+AA*BY
26000		IF(BRK.EQ.0)GO TO 66
26100		RN(8+IS)=1
26200		RN(3+IS)=RB-.6
26220		RB=R(3,K+1)
26225	C  K=END NOTE OF GROUP
26230		IF(K.EQ.IRHY)RB=200.
26240	C  ASSUMES LINE STOPS AT 200. (IT COULD BE LONGER!!)
26250		RN(6+IS)=RA+(RB-RA)/2.
26400		IBR=7
26500	C  CHECK THESE NUMBERS↑↑↑↑
26600		B=RN(4+IS)
26700		BB=RN(5+IS)
26800		RA=1
26900		IF(A.LT.-1)RA=2.5
27000	C  CHANGES HEIGHT.  MAKES BRACK. IF N>100.
27100		IF(NN.GT.0)RA=-RA
27200		RN(4+IS)=B+RA
27300		RN(5+IS)=BB+RA
27400		X=2
27500	66	IF(NN.GT.0)X=-X
27600	510	RN(7+IS)=X
27700		IF(MODE.NE.4)GO TO 2514
27800		RN(9+IS)=0
27900		RN(10+IS)=0
28000		RN(IS+11)=-1
28100		CALL UPDATE(9)
28200		IF(JB)CALL BMX(RA)
28220		GO TO 514
28240	2514	L=IS
28260		CALL UPDATE(IBR)
28430		IF(M.EQ.K)GO TO 514
28435	C JUMP OUT IF INTERVENING NOTE.
28440		IF(RN(L+4).NE.RN(L+5))GO TO 514
28450	C  IS IT LEVEL?
28460		B=-RN(IS-2)
28480	C CHANGE DIRECTION OF DIP AFTER FIRST SLUR.
28490		RA=1.4
28492		IF(RN(L+8).EQ.-1)RA=RA+1.3
28493	C  IS TIE NOT BETWEEN NOTES?
28495		IF(NN.GT.0)RA=-RA
28497	C DIP DIRECTION.  NN+ =DOWN, NN- =UP.  REVERSED AFTER 1ST ONE.
28500		RA=R(4,M)+RA
28520		C=-2.
28540		IF(RN(L+8).EQ.-3.)C=-3.
28560	C PUT TIE BETWEEN NOTES ALWAYS.
28580		JA=M
28600		JB=K
28620	114	JA=JA+1
28640		JB=JB+1
28660		IF(R(4,JA).NE.R(4,JB))GO TO 514
28680	C  LOOKS FOR  PARALLEL CHORDS NOTES
28700		IF(R(9,JA)+R(9,JB).NE.0)GO TO 514
28720	C  MAKES SURE THEY ARE CHORD NOTES.
28740		A=R(4,JA)-RA+RN(L+5)
28760		RN(IS)=6.
28780		RN(IS+1)=5.
28800		RN(IS+2)=RN(IS-7)
28820		RN(IS+3)=RN(IS-6)
28840		RN(IS+6)=RN(IS-3)
28860		RN(IS+7)=B
28880		RN(IS+8)=C
28900		RN(IS+4)=A  
28920		RN(IS+5)=A  
28940		CALL UPDATE(IBR)
28960		GO TO 114
29010	514	J=J+1
29020		A=VX(J)
29030		N=A
29040	C  SO ITEMS NEED NOT BE IN RIGHT ORDER.
29050		IF(MOD(N,100).GT.IRHY)A=0
29060		IF(A.NE.0)GO TO 505
29070		IF(J.LT.50)GO TO 514
29080	C  SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
29100		IF(INP(72).NE.'*')GO TO  552
29200		IF(INVT)RETURN
29300		INVT=IS
29400		CALL NEWR
29500		IS=INVT
29600		RETURN
29700	552	IF(IREAD.NE.0)GO TO 3501
29800		CALL TYPE
29810		WRITE(21,4501)INP
29900		GO TO 5501
30000	3501	IF(IREAD.EQ.-1)READ(22,2501)J,INP
30025		IF(IREAD.EQ.-2)READ(22,4501)INP
30050	5501	CALL LNEND
30075	C  FOR NEW 'SCORE' CONVENTIONS
30100	C  TO READ MORE THAN 2 LINES.
30200		GO TO 25
30300	C  FOR 2ND LINE.
30330	4501	FORMAT(72A1)
30400	2501	FORMAT(I,72A1)
30500	
30600	
30700	35	RA=10.
30800	C  RA WILL=# OF TAILS,  KN=1ST NOTE, K=LAST ('MOD' FOR DOTTED NOTES.)
30900		RN(1+IS)=6
31000		JMAX=0
31100		IF(N-MK.EQ.1)JMAX=-1
31200		DMAX=100.
31300		UMAX=-DMAX
31400	C  FOR AUTO. BEAMS
31500	
31600		JB=0
31610		MB=0
31620	C MB=-1 =GRACE NOTES UNDER BEAMS.  
31630		IF(ABS(R(4,KN)).GE.100.)MB=-1
31700		DO 2 L=KN,K
31800		IF(R(1,L).NE.1)GO TO 2
31805		BB=R(5,L)
31810		IF(BB.GE.10.)GO TO 12
31820		UPDN=-1
31830		NN=19.-AA
31835	C CHORDS WILL HAVE FIXED STEM DIRECTIONS ALWAYS
31840		GO TO 2
31900	C  SKIPS NON-NOTES AND DBLSTPS
31910	12	IF(MB)GO TO 10
31920		AA=BB
32000		RB=R(4,L)
32100		IF(ABS(RB).GE.100)GO TO 2
32200	C  SKIPS GRACE NOTES
32210		GO TO 110
32220	10	RB=XNOTE(L)
32300	110	IF(RB.GT.UMAX)UMAX=RB
32400		IF(RB.LT.DMAX)DMAX=RB
32500	C  FOR AUTO. BEAMS
32600		RB=AMOD(R(7,L),10.0)
32700	112	IF(RA.EQ.RB)GO TO 2
32800		JB=-1
32900	C   FLAG FOR MIXED NUM. OF BEAMS
33000		IF(RB.GE.RA)GO TO 2
33010		IF(RB.NE.0)RA=RB
33100	2	CONTINUE
33200	C  ABOVE FINDS SMALLEST # OF TAILS.  NEXT FOR HGTS.
33300	C  ABOVE IS POS.2
33310		IT=K
33355	C  FOR EXTRA BEAMS WITH CHORDS. SAVE IT IN "IT"
33400		IF(STEM.GT.0)GO TO 577
33402	C  *****↑↑↑↑↑↑ ABOVE WAS ".NE." BEFORE 4/30/76. WHY?#@&Xαε
33405		IF(UPDN.NE.0)GO TO 577
33452		IF(UMAX+DMAX.GE.14)NN=-1
33500	CXX	IF(STEM.GT.0)NN=10.-STEM
33600	C  SETS AUTO. BEAMS' STEM DIRECTION.
33700	577	X=10
33800		IF(NN)X=20
33810		IF(MB)RA=2
33820	C  2 BEAMS ON GRACE NOTES ALWAYS
33900		X=X+RA
34000	C  # OF BEAMS.  IT'S PUT IN  DOWN BELOW 550.
34010	200	M=KN
34020	207	L=M+1
34030		IF(R(1,L).NE.1)GO TO 307
34040		IF(R(9,L).NE.0)GO TO 307
34050		M=M+1
34060		GO TO 207
34070	C  FOR HEIGHTS OF DBL STPS, ETC.
34100	307	A=XNOTE(M)
34200	C   A=NOTE 1.
34300		UMAX=A
34400		DMAX=A
34500	C  UP MAX. NOTE #, DOWN MAX. NOTE #.
34510	407	M=K+1
34530		IF(R(1,M).NE.1)GO TO 103
34550		IF(R(9,M).NE.0)GO TO 103
34555	C  FINDS DBL+ STP ON LAST OF BEAM
34560		K=M
34570		GO TO 407
34600	103	DO 3 M=KN,K
34700		IF(R(1,M).NE.1)GO TO 3
34703		IF(M.EQ.K)GO TO 107
34706		IF(R(9,M+1).EQ.0)GO TO 3
34709	C  IGNORE LOWER (OR UPPER) NOTES OF CHORDS - IN RE. UP-DOWN FEATURE.
34730	107	IF(MB)GO TO 7
34740	C  SKIP IF DEALING WITH GRACE NOTE BEAMS. (MB=-1)
34760		IF(ABS(R(4,M)).GE.100)GO TO 3
34800	C  SKIPS NON-NOTES
34900	7	B=XNOTE(M)
35000	CC	IF(STEM.GT.0)GO TO 55
35010	CC	IF(MODE.NE.5)GO TO 677
35020	CC	IF(STEM.EQ.0)GO TO 55
35060		IF(MODE.EQ.5)GO TO 55
35100	677	Y=R(5,M)
35200	33	IF(NN.GT.0)GO TO 5
35300	C  JUMP IF STEM UP
35400		IF(Y.GE.20.)GO TO 55
35410		IF(Y.LT.10.)GO TO 55
35500		R(5,M)=Y+10.
35600		GO TO  551
35700	5	IF(Y.LT.20.)GO TO 55
35800		R(5,M)=Y-10.
35900	C************************
36000	C    STEM UP
36100	551	INVT=0
36200	55	IF(B.LE.UMAX)GO TO 13
36250	C ↑↑↑↑↑↑↑↑ WAS .LT. !!!!! 5/76
36300		UMAX=B
36400		IF(JMAX)GO TO 3
36410		IF(M.EQ.KN)GO TO 3
36420		IF(M.EQ.K)GO TO 3
36500		UMAX=UMAX+1
36600		GO TO 3
36700	13	IF(B.GT.DMAX)GO TO 3
36800		DMAX=B
36900		IF(JMAX)GO TO 3
36910		IF(M.EQ.KN)GO TO 3
36920		IF(M.EQ.K)GO TO 3
37000		DMAX=DMAX-1
37100	3	CONTINUE
37200	C  LOOKS FOR LOWER AND HIGHER NOTES THAN NOTE 1.
37300	4	IF(MODE.EQ.5)GO TO 62
37310		K=IT
37355	C  FOR EXTRA BEAMS WITH CHORDS. K WAS SAVED IN "IT"
37400		AA=A
37500		BB=B
37600		C=1
37700		IF(X.LT.20.)GO TO 48
37800	C  JUMP IF STEM IS UP
37900		CALL EXCH(AA,BB)
38000		C=-C
38100		CALL EXCH(UMAX,DMAX)
38200	48	IF(AA.LT.BB)GO TO 45
38300		IF(UMAX.EQ.A)GO TO 46
38400	47	A=UMAX-C
38500		B=A
38600		GO TO 444
38700	46	IF(UMAX.GT.AA)GO TO 47
38800		GO TO 49
38900	45	IF(UMAX.NE.B)GO TO 47
39000	49	A=AA
39100		B=BB
39200		IF(X.GE.20)CALL EXCH(A,B)
39300	
39400	444	RN(2+IS)=STAFF 
39500	446	DIS=(RN(IS+6)-RN(IS+3))/DFAC
39600	C  FOR TILT LATER -- DFAC IS IN DATA
39700		IF(ABS(A-B).LT.DIS)GO TO 14
39800		C=C*DIS
39900	C  NEW TILT ROUTINE.  CONSIDERS DISTANCE:HEIGHT
40000	C  LIMITS SLOPE OF BEAM
40100		IF(X.GE.20)GO TO 141
40200		IF(B.GT.A)GO TO 140
40300	142	B=A-C
40400		GO TO 14
40500	141	IF(B.GT.A)GO TO 142
40600	140	A=B-C
40610	14	IF(MB.EQ.0)GO TO 143
40620	C NEXT FOR GRACE NOTE BEAMS (MB=-1)
40630		C=100
40640		IF(A)C=-C
40650		A=A+C
40700	143	RN(4+IS)=A
40800		RN(5+IS)=B
40900	C   MAKES HORIZONTAL BEAMS IF PATTERN IS UP-DOWN.
41000		RN(6+IS)=R(3,K)
41100	C  ABOVE IS POS.2
41200		GO TO 510
41300	
41400	C   NEXT IS FOR ACCENTS AND OTHER MARKS
41500	
41600	30	CALL MARKS(RA)
41700		J=J+1
41800		IF(RA.EQ.99)RA=VX(J)
41900	C  IF STEM IS DOWN OR THERE ARE NOTES BELOW(DBL STP), POSITION
42000	C    OF ACCENT WILL BE INVERTED.
42010		IF(RA.LT.40)GO TO 304
42020		NN=6
42025		BB=-4
42030		A=3
42040		B=3
42045		IF(R(4,K).LT.3)BB=R(4,K)-7.5
42047	C LOWERS ITEM IF NOTE BELOW STAFF.  BUT IS 'K' ALWAYS OK HERE??????
42050		IF(RA.LT.99)GO TO 305
42060	C NEXT FOR CRESC. & DECRSC. LINES<,>. TYPE /NT1 C+ NT2/ OR /N1.d  C- N2.d/
42070		NN=8
42075		BB=BB+2.5
42080		A=5
42090		B=4
42100		RN(IS+7)=RA-200
42110	C  MAKES ZERO OR -1 IN P7
42120		RA=50
42139	C  ADDS A NEW ITEM.  MP, PP, CRESC., ETC. --CODE 3
42140	305	RN(IS)=A
42160		RN(IS+1)=B
42180		RN(IS+2)=STAFF
42197	C  PUTS MF, ETC. BETWEEN NOTES.  (I HOPE)  SEE 'FUNCTION POSIT' BELOW
42200		RN(IS+3)=POSIT(VX(J-1))
42210	C  '+2' PUSHES IT TO RIGHT. MAYBE CHANGE ORIGINAL POSITIONS??
42220		RN(IS+4)=BB
42240	C  DIST. BELOW STAFF
42260		RN(IS+5)=RA
42280	C  THE CODE NUM IN 'CLEFS' LIST
42300		IS=IS+NN
42310		IF(NN.EQ.6)GO TO 514
42315		J=J+1
42317		RN(IS-2)=POSIT(VX(J))
42318	C  THIS IS P6 (POS2 FOR CRESC. LINES)
42320		GO TO 514
42470	304	RB=R(6,K)
42477		B=10.
42484		IF(RA.EQ.6)RA=26.
42491	C TEMPORARY CHANGE FOR FERMATA*******
42500		IF(RA.GT.10.)RA=RA/10.
42600		A=ABS(AMOD(RB,1.))
42700		IF(A.EQ.0)GO TO 301
42800		IF(RA.GT.3)GO TO 303
42900		RB=FLOAT(IFIX(RB))
43000		RA=RA+A/10.
43100	C  THIS PUTS 2-DIGIT CODE BEFORE 1-DIGIT CODE.
43200		GO TO 301
43300	303	IF(A.LT..3)GO TO 302
43400		B=100.
43500		GO TO 301
43600	302	B=1000.
43700	301	IF(RB.LT.0)RA=-RA
43800		R(6,K)=RB+RA/B
43900		GO TO 514
44000	C   USES 4-7,9,11-13 FOR ACC. > FERM. DOT - DNBOW UPBOW HARM.
44100	C  NOTE#,ACCENT#/N,A/N,A*
44200		END
44300	
44400	CF	FUNCTION XNOTE(J)
44500	CF	COMMON/XRN/RN(4000)
44600	CF	DIMENSION R(10,80)
44700	CF	EQUIVALENCE (R,RN(3001))
44800	CF	XNOTE=AMOD(R(4,J),100.)
44900	CF	END
45000	
45100	CF	SUBROUTINE BAUTO(J,L,K,N)
45200	C  FOR AUTOMATIC BEAMS.
45300	CF	COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
45400	CF	J=J+2
45500	CF	V(J-1)=L-N
45600	CF	V(J)=K-N
45700	CF	END
45800	
45900	CF	SUBROUTINE UPDATE(I)
46000	CF	COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
46100	CF	RN(IS)=I
46200	CF	IS=IS+I+3
46300	CF	END
46400	
46500	C	SUBROUTINE SLEND
46510	C	INTEGER PWDS
46550	C  TO FIND END POINTS OF STAVES
46600	C	COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,DMAX,
46700	C	1 UMAX,AA,JMAX,X,Y,BB,RNX(1982)
46900	     1/SCM/V(78),I,LCNT,STAFF,LIST(200),REND/PTR/PWDS(250),ITEM,LL,IS,IX
47200	C	DO 1 K=1,ITEM
47300	C	L=PWDS(K)
47400	C	IF(RN(L+1).NE.8)GO TO 1
47450	C  FOUND A STAFF
47475	C	IF(RN(L+2).NE.STAFF)GO TO 1
47487	C GOT THE RIGHT ONE
47500	C	IF(IT)GO TO 2
47550	C	POS=202
47600	C NOW CHECK LEFT SIDE OF STAFF
47700	C	IF(RN(L).LT.4)RETURN
47800	C P6 WASN'T MENTIONED - SO IT =200
47900	C	POS=RN(L+6)+2
48000	C	IF(POS.EQ.2)POS=202
48100	C	RETURN
48200	C2	POS=RN(L+3)-2.3
48300	C	RETURN
48400	C1	CONTINUE
48500	C	END
48510	
48600	C	FUNCTION POSIT(V)
48700	C	COMMON/XRN/RN(4000)
48800	C	DIMENSION POSNT(0/82)
48900	C	EQUIVALENCE (POSNT,RN(3801))
48950	C	1,(A,RN(3884)),(K,RN(3885))
48975	C	IF(V)V=-V
48987	C  REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
49000	C	K=V
49100	C	A=POSNT(K)
49200	C	POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
49300	C  TYPE  /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
49400	C	END